home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / docs / winer / dbpack.bas < prev    next >
Encoding:
BASIC Source File  |  1992-05-13  |  1.4 KB  |  51 lines
  1. '*********** DBPACK.BAS - removes deleted records from a DBF file
  2.  
  3. 'Copyright (c) 1992 Ethan Winer
  4.  
  5. 'NOTE: Please make a copy of your .DBF file before running this program.
  6. '      Unlike dBASE that works with a copy of the data file, this program
  7. '      packs, swaps records, and then truncates the original data file.
  8.  
  9. DEFINT A-Z
  10. '$INCLUDE: 'DBF.BI'
  11. '$INCLUDE: 'DBACCESS.BI'
  12. '$INCLUDE: 'REGTYPE.BI'
  13.  
  14. DIM Registers AS RegType
  15. DIM Header AS DBFHeadStruc
  16. REDIM FldStruc(1 TO 1) AS FieldStruc
  17.  
  18. LINE INPUT "Enter the dBASE file name: ", DBFName$
  19. IF INSTR(DBFName$, ".") = 0 THEN
  20.   DBFName$ = DBFName$ + ".DBF"
  21. END IF
  22.  
  23. CALL OpenDBF(1, DBFName$, Header, FldStruc())
  24.  
  25. Record$ = SPACE$(Header.RecLen)
  26. GoodRecs& = 0
  27.  
  28. FOR Rec& = 1 TO Header.TRecs
  29.   GetRecord 1, Rec&, Record$, Header
  30.   IF NOT Deleted%(Record$) THEN
  31.     CALL SetRecord(1, GoodRecs& + 1, Record$, Header)
  32.     GoodRecs& = GoodRecs& + 1
  33.   END IF
  34. NEXT
  35.  
  36. 'This trick truncates the file
  37.  
  38. RecOff& = (GoodRecs& * Header.RecLen) + Header.FirstRec
  39. Eof$ = CHR$(26)
  40. PUT #1, RecOff&, Eof$
  41. SEEK #1, RecOff& + 1
  42.  
  43. Registers.AX = &H4000           'service to write to a file
  44. Registers.BX = FILEATTR(1, 2)   'get the DOS handle
  45. Registers.CX = 0                'write 0 bytes to truncate
  46. CALL Interrupt(&H21, Registers, Registers)
  47. CALL CloseDBF(1, GoodRecs&)
  48.  
  49. PRINT "All of the deleted records were removed from "; DBFName$
  50. PRINT GoodRecs&; "remaining records"
  51.